module Emit
  ( toC,
    envToC,
    globalsToC,
    projectIncludesToC,
    projectPreprocToC,
    envToDeclarations,
    checkForUnresolvedSymbols,
    ToCMode (..),
    wrapInInitFunction,
    typeEnvToDeclarations,
  )
where

import Control.Monad.State
import Data.Char (ord)
import Data.Functor ((<&>))
import Data.List (intercalate, isPrefixOf, sortOn)
import Data.Maybe (fromJust, fromMaybe)
import Env
import Info
import qualified Map
import qualified Meta
import Obj
import Path (takeFileName)
import Project
import Scoring
import qualified Set
import Template
import TypePredicates
import Types
import TypesToC
import Util

addIndent :: Int -> String
addIndent n = replicate n ' '

indentAmount :: Int
indentAmount = 4

data ToCError
  = InvalidParameter XObj
  | InvalidList XObj
  | DontVisitObj XObj
  | CannotEmitUnit XObj
  | CannotEmitExternal XObj
  | CannotEmitModKeyword XObj
  | BinderIsMissingType Binder
  | UnresolvedMultiSymbol XObj
  | UnresolvedInterfaceSymbol XObj
  | UnresolvedGenericType XObj
  | CannotSet XObj

instance Show ToCError where
  show (InvalidParameter xobj) =
    "I encountered an invalid parameter `" ++ show (xobjObj xobj) ++ "` at "
      ++ prettyInfoFromXObj xobj
      ++ "."
  show (InvalidList xobj) =
    "I encountered an invalid list `" ++ show (xobjObj xobj) ++ "` at "
      ++ prettyInfoFromXObj xobj
      ++ "."
  show (DontVisitObj xobj) =
    "I can’t visit " ++ show (xobjObj xobj) ++ " at " ++ prettyInfoFromXObj xobj
      ++ "."
  show (CannotEmitUnit xobj) =
    "I can't emit code for the unit type `()` at" ++ prettyInfoFromXObj xobj
      ++ "."
  show (CannotEmitExternal xobj) =
    "I can’t emit code for the external function/variable `"
      ++ show (xobjObj xobj)
      ++ "` at "
      ++ prettyInfoFromXObj xobj
      ++ "."
  show (CannotEmitModKeyword xobj) =
    "I can’t emit code for the module `" ++ show (xobjObj xobj) ++ "` at "
      ++ prettyInfoFromXObj xobj
      ++ "."
  show (BinderIsMissingType b) =
    "I encountered a binder `" ++ show b ++ "` that is missing its type."
  show (UnresolvedMultiSymbol xobj@(XObj (MultiSym symName symPaths) _ _)) =
    "I found an ambiguous symbol `" ++ symName
      ++ "` at "
      ++ prettyInfoFromXObj xobj
      ++ "\n\nPossibilities:\n  "
      ++ joinWith "\n  " (map show symPaths)
      ++ "\n\nAll possibilities have the correct type."
  show (UnresolvedMultiSymbol _) = error "show unresolvedmultisymbol"
  show (UnresolvedInterfaceSymbol xobj@(XObj (InterfaceSym symName) _ _)) =
    "I found an interface `" ++ symName
      ++ "` that is unresolved in the context at "
      ++ prettyInfoFromXObj xobj
  show (UnresolvedInterfaceSymbol _) = error "show unresolvedinterfacesymbol"
  show (UnresolvedGenericType xobj@(XObj _ _ (Just t))) =
    "I found an unresolved generic type `" ++ show t
      ++ "` for the expression `"
      ++ pretty xobj
      ++ "` at "
      ++ prettyInfoFromXObj xobj
  show (UnresolvedGenericType _) = error "show unresolvedgenerictype"
  show (CannotSet xobj) =
    "I can’t emit code for setting `" ++ pretty xobj ++ "` at "
      ++ prettyInfoFromXObj xobj
      ++ "\n\nOnly variables can be reset using `set!`."

data ToCMode = Functions | Globals | All deriving (Show)

newtype EmitterState = EmitterState {emitterSrc :: String}

appendToSrc :: String -> State EmitterState ()
appendToSrc moreSrc = modify (\s -> s {emitterSrc = emitterSrc s ++ moreSrc})

toC :: ToCMode -> Binder -> String
toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent root) (EmitterState ""))
  where
    startingIndent = case toCMode of
      Functions -> 0
      Globals -> 4
      All -> 0
    visit :: Int -> XObj -> State EmitterState String
    visit indent xobj =
      let dontVisit = error (show (DontVisitObj xobj))
       in case xobjObj xobj of
            Lst _ -> visitList indent xobj
            Arr _ -> visitArray indent xobj
            StaticArr _ -> visitStaticArray indent xobj
            Num IntTy num -> pure (show num)
            Num LongTy num -> pure (show num ++ "l")
            Num ByteTy num -> pure (show num)
            Num FloatTy num -> pure (show num ++ "f")
            Num DoubleTy num -> pure (show num)
            Num _ _ -> error "Can't emit invalid number type."
            Bol b -> pure (if b then "true" else "false")
            Str _ -> visitString indent xobj
            Pattern _ -> visitString indent xobj
            Chr c -> pure $ case c of
              '\t' -> "'\\t'"
              '\n' -> "'\\n'"
              '\\' -> "'\\\\'"
              x -> show (ord x) ++ "/*" ++ show x ++ "*/" -- ['U', '\'', x, '\'']
            Closure elt _ -> visit indent elt
            Sym _ _ -> visitSymbol indent xobj
            Mod _ _ -> error (show (CannotEmitModKeyword xobj))
            External _ -> error (show (CannotEmitExternal xobj))
            (Defn _) -> dontVisit
            Def -> dontVisit
            Let -> dontVisit
            If -> dontVisit
            Break -> dontVisit
            While -> dontVisit
            Do -> dontVisit
            (Deftype _) -> dontVisit
            (DefSumtype _) -> dontVisit
            ExternalType _ -> dontVisit
            (Command _) -> dontVisit
            (Primitive _) -> dontVisit
            (Deftemplate _) -> dontVisit
            (Instantiate _) -> dontVisit
            (Defalias _) -> dontVisit
            (MultiSym _ _) -> dontVisit
            (InterfaceSym _) -> dontVisit
            SetBang -> dontVisit
            Macro -> dontVisit
            Dynamic -> dontVisit
            DefDynamic -> dontVisit
            The -> dontVisit
            Ref -> dontVisit
            Deref -> dontVisit
            (Interface _ _) -> dontVisit
            (Dict _) -> dontVisit
            (Fn _ _) -> dontVisit
            LocalDef -> dontVisit
            (Match _) -> dontVisit
            With -> dontVisit
            MetaStub -> dontVisit
            C c -> pure c
    visitStr' indent str i shouldEscape =
      -- This will allocate a new string every time the code runs:
      -- do let var = freshVar i
      --    appendToSrc (addIndent indent ++ "String " ++ var ++ " = strdup(\"" ++ str ++ "\");\n")
      --    pure var
      -- This will use the statically allocated string in the C binary (can't be freed):
      do
        let var = freshVar i
            varRef = freshVar i ++ "_ref"
        appendToSrc (addIndent indent ++ "static String " ++ var ++ " = \"" ++ (if shouldEscape then escapeString str else str) ++ "\";\n")
        appendToSrc (addIndent indent ++ "String *" ++ varRef ++ " = &" ++ var ++ ";\n")
        pure varRef
    visitString indent (XObj (Str str) (Just i) _) = visitStr' indent str i True
    visitString indent (XObj (Pattern str) (Just i) _) = visitStr' indent str i False
    visitString _ _ = error "Not a string."
    escaper '\"' acc = "\\\"" ++ acc
    escaper '\\' acc = "\\\\" ++ acc
    escaper '\n' acc = "\\n" ++ acc
    escaper '\a' acc = "\\a" ++ acc
    escaper '\b' acc = "\\b" ++ acc
    escaper '\f' acc = "\\f" ++ acc
    escaper '\r' acc = "\\r" ++ acc
    escaper '\t' acc = "\\t" ++ acc
    escaper '\v' acc = "\\v" ++ acc
    escaper x acc = x : acc
    escapeString = foldr escaper ""
    visitSymbol :: Int -> XObj -> State EmitterState String
    visitSymbol _ (XObj (Sym _ (LookupGlobalOverride overrideWithName)) _ _) =
      pure overrideWithName
    visitSymbol indent xobj@(XObj sym@(Sym path lookupMode) (Just i) ty) =
      let t = fromMaybe (error "emit: symbol has no type") $ ty
       in if isTypeGeneric t
            then
              error
                ( "Can't emit symbol of generic type: "
                    ++ show path
                    ++ " : "
                    ++ show t
                    ++ " at "
                    ++ prettyInfoFromXObj xobj
                )
            else
              if isFunctionType t && not (isLookupLocal lookupMode) && not (isGlobalVariableLookup lookupMode)
                then do
                  let var = freshVar i
                  appendToSrc (addIndent indent ++ "Lambda " ++ var ++ " = { .callback = (void*)" ++ pathToC path ++ ", .env = NULL, .delete = NULL, .copy = NULL }; //" ++ show sym ++ "\n")
                  pure var
                else pure $ case lookupMode of
                  LookupLocal (Capture _) -> "_env->" ++ pathToC path
                  _ -> pathToC path
    visitSymbol _ xobj@(XObj (Sym _ _) Nothing _) = error ("Symbol missing info: " ++ show xobj)
    visitSymbol _ _ = error "Not a symbol."
    visitList :: Int -> XObj -> State EmitterState String
    visitList indent (XObj (Lst xobjs) (Just info) ty) =
      case xobjs of
        -- Defn
        [XObj (Defn _) _ _, XObj (Sym path@(SymPath _ name) _) _ _, XObj (Arr argList) _ _, body] ->
          case toCMode of
            Globals ->
              pure ""
            _ ->
              do
                let innerIndent = indent + indentAmount
                    retTy = case ty of
                      Just (FuncTy _ rt _) -> rt
                      _ -> error "emit: defn has no return type"
                    defnDecl = defnToDeclaration meta path argList retTy
                    isMain = name == "main"
                appendToSrc (defnDecl ++ " {\n")
                when isMain $
                  appendToSrc (addIndent innerIndent ++ "carp_init_globals(argc, argv);\n")
                ret <- visit innerIndent body
                delete innerIndent info
                case retTy of
                  UnitTy -> when isMain $ appendToSrc (addIndent innerIndent ++ "return 0;\n")
                  _ -> appendToSrc (addIndent innerIndent ++ "return " ++ ret ++ ";\n")
                appendToSrc "}\n\n"
                pure ""
        -- Fn / λ
        [XObj (Fn name set) _ _, XObj (Arr _) _ _, _] ->
          do
            let retVar = freshVar info
                capturedVars = Set.toList set
                callback = fromMaybe (SymPath [] "") name
                callbackMangled = pathToC callback
                needEnv = not (null capturedVars)
                lambdaEnvTypeName = (SymPath [] (callbackMangled ++ "_ty")) -- The name of the struct is the callback name with suffix '_ty'.
                lambdaEnvType = StructTy (ConcreteNameTy lambdaEnvTypeName) []
                lambdaEnvName = freshVar info ++ "_env"
            appendToSrc
              ( addIndent indent ++ "// This lambda captures "
                  ++ show (length capturedVars)
                  ++ " variables: "
                  ++ joinWithComma (map getName capturedVars)
                  ++ "\n"
              )
            when needEnv $
              do
                appendToSrc
                  ( addIndent indent ++ tyToC lambdaEnvType ++ " *" ++ lambdaEnvName
                      ++ " = CARP_MALLOC(sizeof("
                      ++ tyToC lambdaEnvType
                      ++ "));\n"
                  )
                mapM_
                  ( \xobj ->
                      case xobj of
                        (XObj (Sym path lookupMode) _ _) ->
                          appendToSrc
                            ( addIndent indent ++ lambdaEnvName ++ "->"
                                ++ pathToC path
                                ++ " = "
                                ++ ( case lookupMode of
                                       LookupLocal (Capture _) -> "_env->" ++ pathToC path
                                       _ -> pathToC path
                                   )
                                ++ ";\n"
                            )
                        _ -> appendToSrc ""
                  )
                  (remove (isUnit . forceTy) capturedVars)
            appendToSrc (addIndent indent ++ "Lambda " ++ retVar ++ " = {\n")
            appendToSrc (addIndent indent ++ "  .callback = (void*)" ++ callbackMangled ++ ",\n")
            appendToSrc (addIndent indent ++ "  .env = " ++ (if needEnv then lambdaEnvName else "NULL") ++ ",\n")
            appendToSrc (addIndent indent ++ "  .delete = (void*)" ++ (if needEnv then "" ++ show lambdaEnvTypeName ++ "_delete" else "NULL") ++ ",\n")
            appendToSrc (addIndent indent ++ "  .copy = (void*)" ++ (if needEnv then "" ++ show lambdaEnvTypeName ++ "_copy" else "NULL") ++ "\n")
            appendToSrc (addIndent indent ++ "};\n")
            pure retVar
        -- Def
        [XObj Def _ _, XObj (Sym path _) _ _, expr] ->
          case toCMode of
            Functions ->
              pure ""
            _ ->
              do
                appendToSrc (addIndent indent ++ "{\n")
                let innerIndent = indent + indentAmount
                    cname = (Meta.getString (Meta.getCompilerKey Meta.CNAME) meta)
                    fullname = if (null cname) then pathToC path else cname
                ret <- visit innerIndent expr
                when (ret /= "") $ appendToSrc (addIndent innerIndent ++ fullname ++ " = " ++ ret ++ ";\n")
                delete innerIndent info
                appendToSrc (addIndent indent ++ "}\n")
                pure ""
        -- Let
        [XObj Let _ _, XObj (Arr bindings) _ _, body] ->
          let indent' = indent + indentAmount
           in do
                let bodyTy = fromMaybe (error "emit: let body has no type") $ xobjTy body
                    isNotVoid = bodyTy /= UnitTy
                    letBodyRet = freshVar info
                when isNotVoid $ -- Must be declared outside the scope
                  appendToSrc (addIndent indent ++ tyToCLambdaFix bodyTy ++ " " ++ letBodyRet ++ ";\n")
                appendToSrc (addIndent indent ++ "/* let */ {\n")
                let letBindingToC (XObj (Sym (SymPath _ symName) _) _ _) expr =
                      do
                        ret <- visit indent' expr
                        let bindingTy = fromMaybe (error "emit: let binding value has no type") $ xobjTy expr
                        unless (isUnit bindingTy) $
                          appendToSrc (addIndent indent' ++ tyToCLambdaFix bindingTy ++ " " ++ mangle symName ++ " = " ++ ret ++ ";\n")
                    letBindingToC _ _ = error "Invalid binding."
                mapM_ (uncurry letBindingToC) (pairwise bindings)
                ret <- visit indent' body
                when isNotVoid $
                  appendToSrc (addIndent indent' ++ letBodyRet ++ " = " ++ ret ++ ";\n")
                delete indent' info
                appendToSrc (addIndent indent ++ "}\n")
                pure letBodyRet
        -- If
        [XObj If _ _, expr, ifTrue, ifFalse] ->
          let indent' = indent + indentAmount
           in do
                let isNotVoid = xobjTy ifTrue /= Just UnitTy
                    ifRetVar = freshVar info
                when isNotVoid $
                  let ifT = fromMaybe (error "emit: if true branch has no type") $ xobjTy ifTrue
                   in appendToSrc (addIndent indent ++ tyToCLambdaFix ifT ++ " " ++ ifRetVar ++ ";\n")
                exprVar <- visit indent expr
                appendToSrc (addIndent indent ++ "if (" ++ exprVar ++ ") {\n")
                trueVar <- visit indent' ifTrue
                let ifTrueInfo = infoOrUnknown $ xobjInfo ifTrue
                delete indent' ifTrueInfo
                when isNotVoid $
                  appendToSrc (addIndent indent' ++ ifRetVar ++ " = " ++ trueVar ++ ";\n")
                appendToSrc (addIndent indent ++ "} else {\n")
                falseVar <- visit indent' ifFalse
                let ifFalseInfo = infoOrUnknown $ xobjInfo ifFalse
                delete indent' ifFalseInfo
                when isNotVoid $
                  appendToSrc (addIndent indent' ++ ifRetVar ++ " = " ++ falseVar ++ ";\n")
                appendToSrc (addIndent indent ++ "}\n")
                pure ifRetVar
        -- Match
        XObj (Match matchMode) _ _ : expr@(XObj _ (Just exprInfo) (Just exprTyNotFixed)) : rest ->
          let indent' = indent + indentAmount
              retVar = freshVar info
              isNotVoid = ty /= Just UnitTy
              exprTy = exprTyNotFixed
              tagCondition :: String -> String -> Ty -> XObj -> [String]
              tagCondition var periodOrArrow caseTy ((XObj (Lst (XObj (Sym (SymPath _ caseName) _) _ _ : caseMatchers)) _ _)) =
                -- HACK! The function 'removeSuffix' ignores the type specialisation of the tag name and just uses the base name
                -- A better idea is to not specialise the names, which happens when calling 'concretize' on the lhs
                -- This requires a bunch of extra machinery though, so this will do for now...

                (var ++ periodOrArrow ++ "_tag == " ++ tagName caseTy (removeSuffix caseName)) :
                concat (zipWith (\c i -> tagCondition (var ++ periodOrArrow ++ "u." ++ removeSuffix caseName ++ ".member" ++ show i) "." (forceTy c) c) unitless ([0 ..] :: [Int]))
                where
                  unitless = remove (isUnit . forceTy) caseMatchers
              tagCondition _ _ _ _ =
                []
              --error ("tagCondition fell through: " ++ show x)

              tempVarToAvoidClash = freshVar exprInfo ++ "_temp"
              emitCaseMatcher :: (String, String) -> String -> XObj -> Integer -> State EmitterState ()
              emitCaseMatcher (periodOrArrow, ampersandOrNot) caseName (XObj (Sym path _) _ t) index =
                let tt = fromMaybe (error "emit: case matcher has no type") $ t
                 in appendToSrc
                      ( addIndent indent' ++ tyToCLambdaFix tt ++ " " ++ pathToC path ++ " = "
                          ++ ampersandOrNot
                          ++ tempVarToAvoidClash
                          ++ periodOrArrow
                          ++ "u."
                          ++ mangle caseName
                          ++ ".member"
                          ++ show index
                          ++ ";\n"
                      )
              emitCaseMatcher periodOrArrow caseName (XObj (Lst (XObj (Sym (SymPath _ innerCaseName) _) _ _ : xs)) _ _) index =
                zipWithM_ (\x i -> emitCaseMatcher periodOrArrow (caseName ++ ".member" ++ show i ++ ".u." ++ removeSuffix innerCaseName) x index) xs ([0 ..] :: [Int])
              emitCaseMatcher _ _ xobj _ =
                error ("Failed to emit case matcher for: " ++ pretty xobj)
              removeOuterRefTyIfMatchRef :: Ty -> Ty
              removeOuterRefTyIfMatchRef t =
                case matchMode of
                  MatchValue -> t
                  MatchRef ->
                    case t of
                      RefTy inner _ -> inner
                      _ -> error ("Failed to remove outer ref on type " ++ show t)
              emitCase :: String -> Bool -> (XObj, XObj) -> State EmitterState ()
              emitCase _ _ (caseLhs@(XObj (Lst (XObj Ref _ _ : _)) _ _), _) =
                error ("Can't emit case matchers for refs: " ++ pretty caseLhs)
              emitCase exprVar isFirst (caseLhs@(XObj (Lst (XObj (Sym (SymPath _ caseName@(_ : _)) _) _ _ : caseMatchers)) caseLhsInfo _), caseExpr) =
                -- A list of things, beginning with a tag
                do
                  appendToSrc (addIndent indent)
                  unless isFirst (appendToSrc "else ")
                  let refModifications =
                        case matchMode of
                          MatchValue -> (".", "")
                          MatchRef -> ("->", "&")
                  appendToSrc ("if(" ++ joinWith " && " (tagCondition exprVar (fst refModifications) (removeOuterRefTyIfMatchRef exprTy) caseLhs) ++ ") {\n")
                  appendToSrc (addIndent indent' ++ tyToCLambdaFix exprTy ++ " " ++ tempVarToAvoidClash ++ " = " ++ exprVar ++ ";\n")
                  zipWithM_ (emitCaseMatcher refModifications (removeSuffix caseName)) (remove (isUnit . forceTy) caseMatchers) [0 ..]
                  appendToSrc (addIndent indent' ++ "// Case expr:\n")
                  emitCaseEnd caseLhsInfo caseExpr
              emitCase exprVar isFirst (XObj (Sym firstPath _) caseLhsInfo _, caseExpr) =
                -- Single variable
                do
                  appendToSrc (addIndent indent)
                  unless isFirst (appendToSrc "else ")
                  appendToSrc "if(true) {\n"
                  appendToSrc (addIndent indent' ++ tyToCLambdaFix exprTy ++ " " ++ tempVarToAvoidClash ++ " = " ++ exprVar ++ ";\n")
                  appendToSrc
                    ( addIndent indent' ++ tyToCLambdaFix exprTy ++ " "
                        ++ pathToC firstPath
                        ++ " = "
                        ++ tempVarToAvoidClash
                        ++ ";\n" -- Store the whole expr in a variable
                    )
                  emitCaseEnd caseLhsInfo caseExpr
              emitCase _ _ x =
                error ("Fell through: " ++ show x)
              emitCaseEnd caseLhsInfo caseExpr = do
                caseExprRetVal <- visit indent' caseExpr
                when isNotVoid $
                  appendToSrc (addIndent indent' ++ retVar ++ " = " ++ caseExprRetVal ++ ";\n")
                let caseLhsInfo' = infoOrUnknown caseLhsInfo
                delete indent' caseLhsInfo'
                appendToSrc (addIndent indent ++ "}\n")
           in do
                exprVar <- visit indent expr
                when isNotVoid $
                  let t = fromMaybe (error "emit: match expression has no type") $ ty
                   in appendToSrc (addIndent indent ++ tyToCLambdaFix t ++ " " ++ retVar ++ ";\n")
                zipWithM_ (emitCase exprVar) (True : repeat False) (pairwise rest)
                appendToSrc (addIndent indent ++ "else UNHANDLED(\"" ++ takeFileName (infoFile info) ++ "\", " ++ show (infoLine info) ++ ");\n")
                pure retVar
        XObj (Match _) _ _ : _ ->
          error "Fell through match."
        -- While
        [XObj While _ _, expr, body] ->
          let indent' = indent + indentAmount
              exprTy = fromMaybe (error "emit: called on while expression has no type") $ xobjTy expr
              conditionVar = freshVar info
              exprInfo = infoOrUnknown $ xobjInfo expr
           in do
                exprRetVar <- visitWhileExpression indent
                appendToSrc (addIndent indent ++ tyToCLambdaFix exprTy ++ " " ++ conditionVar ++ " = " ++ exprRetVar ++ ";\n")
                delete indent exprInfo
                appendToSrc (addIndent indent ++ "while (" ++ conditionVar ++ ") {\n")
                _ <- visit indent' body
                exprRetVar' <- visitWhileExpression indent'
                delete indent' info
                appendToSrc (addIndent indent' ++ conditionVar ++ " = " ++ exprRetVar' ++ ";\n")
                appendToSrc (addIndent indent ++ "}\n")
                pure ""
          where
            visitWhileExpression :: Int -> State EmitterState String
            visitWhileExpression ind =
              do
                s <- get
                let (exprRetVar, exprResultState) = runState (visit ind expr) (EmitterState "")
                    exprSrc = emitterSrc exprResultState
                modify
                  ( \x ->
                      x
                        { emitterSrc = emitterSrc s ++ exprSrc
                        }
                  )
                pure exprRetVar
        -- Do
        XObj Do _ _ : expressions ->
          do
            let lastExpr = last expressions
                retVar = freshVar info
            mapM_ (visit indent) (init expressions)
            let lastTy = fromMaybe (error "emit: final expression in do has no type") $ xobjTy lastExpr
            if lastTy == UnitTy
              then do
                _ <- visit indent lastExpr
                pure ""
              else do
                lastRet <- visit indent lastExpr
                appendToSrc (addIndent indent ++ tyToCLambdaFix lastTy ++ " " ++ retVar ++ " = " ++ lastRet ++ ";\n")
                pure retVar
        -- Set!
        [XObj SetBang _ _, variable, value] ->
          do
            valueVar <- visit indent value
            let properVariableName =
                  case variable of
                    (XObj (Lst (XObj (Sym (SymPath _ "copy") _) _ _ : (XObj (Sym sym _) _ _) : _)) _ _) -> "*" ++ pathToC sym
                    (XObj (Sym sym _) _ _) -> pathToC sym
                    _ -> error (show (CannotSet variable))
                varInfo = infoOrUnknown $ xobjInfo variable
            --appendToSrc (addIndent indent ++ "// " ++ show (length (infoDelete varInfo)) ++ " deleters for " ++ properVariableName ++ ":\n")
            delete indent varInfo
            appendToSrc
              ( addIndent indent ++ properVariableName ++ " = " ++ valueVar ++ "; "
                  ++ " // "
                  ++ show (fromMaybe (VarTy "?") (xobjTy variable))
                  ++ " = "
                  ++ show (fromMaybe (VarTy "?") (xobjTy value))
                  ++ "\n"
              )
            pure ""
        -- The
        [XObj The _ _, _, value] ->
          do
            var <- visit indent value
            let t = fromMaybe (error "emit: called emit on the with no type") ty
                fresh = mangle (freshVar info)
            unless
              (isUnit t)
              (appendToSrc (addIndent indent ++ tyToCLambdaFix t ++ " " ++ fresh ++ " = " ++ var ++ "; // From the 'the' function.\n"))
            pure fresh
        -- Ref
        [XObj Ref _ _, value] ->
          do
            var <- visit indent value
            let t = case ty of
                  Just typ -> typ
                  _ -> error "emit: called emit on ref with no type"
                fresh = mangle (freshVar info)
            case t of
              (RefTy UnitTy _) -> appendToSrc ""
              _ ->
                if isNumericLiteral value
                  then do
                    let literal = freshVar info ++ "_lit"
                        literalTy = case xobjTy value of
                          Just typ -> typ
                          _ -> error "called emit on ref without value type"
                    appendToSrc (addIndent indent ++ "static " ++ tyToCLambdaFix literalTy ++ " " ++ literal ++ " = " ++ var ++ ";\n")
                    appendToSrc (addIndent indent ++ tyToCLambdaFix t ++ " " ++ fresh ++ " = &" ++ literal ++ "; // ref\n")
                  else appendToSrc (addIndent indent ++ tyToCLambdaFix t ++ " " ++ fresh ++ " = &" ++ var ++ "; // ref\n")
            pure fresh
        -- Deref
        [XObj Deref _ _, value] ->
          do
            x <- visit indent value
            pure ("(*" ++ x ++ ")")
        -- Deftype
        XObj (Deftype _) _ _ : XObj (Sym _ _) _ _ : _ ->
          pure ""
        -- DefSumtype
        XObj (DefSumtype _) _ _ : XObj (Sym _ _) _ _ : _ ->
          pure ""
        -- Template
        [XObj (Deftemplate _) _ _, XObj (Sym _ _) _ _] ->
          pure ""
        [XObj (Instantiate template) _ _, XObj (Sym path _) _ _] ->
          case toCMode of
            Globals ->
              pure ""
            _ ->
              do
                case ty of
                  Just t ->
                    do
                      appendToSrc (templateToC template path t)
                      pure ""
                  _ -> pure "" -- called with no type
                  -- Alias
        XObj (Defalias _) _ _ : _ ->
          pure ""
        -- External
        XObj (External _) _ _ : _ ->
          pure ""
        -- Macro
        XObj Macro _ _ : _ ->
          pure ""
        -- Dynamic
        XObj Dynamic _ _ : _ ->
          pure ""
        -- DefDynamic
        XObj DefDynamic _ _ : _ ->
          pure ""
        -- Command
        XObj (Command _) _ _ : _ ->
          pure ""
        -- Primitive
        XObj (Primitive _) _ _ : _ ->
          pure ""
        -- Interface
        XObj (Interface _ _) _ _ : _ ->
          pure ""
        -- Break
        [XObj Break minfo _] -> do
          case minfo of
            Just i -> delete indent i
            Nothing -> return ()
          appendToSrc (addIndent indent ++ "break;\n")
          appendToSrc (addIndent indent ++ "// Unreachable:\n")
          pure ""
        -- Function application (functions with overridden names)
        func@(XObj (Sym _ (LookupGlobalOverride overriddenName)) _ _) : args ->
          do
            argListAsC <- createArgList indent True args -- The 'True' means "unwrap lambdas" which is always the case for functions with overriden names (they are external)
            let retTy = case xobjTy func of
                  Just (FuncTy _ rt _) -> rt
                  _ -> error ("No type on func " ++ show func)
                callFunction = overriddenName ++ "(" ++ argListAsC ++ ");\n"
            if isUnit retTy
              then do
                appendToSrc (addIndent indent ++ callFunction)
                pure ""
              else do
                let varName = freshVar info
                appendToSrc (addIndent indent ++ tyToCLambdaFix retTy ++ " " ++ varName ++ " = " ++ callFunction)
                pure varName
        -- Function application (global symbols that are functions -- lambdas stored in def:s need to be called like locals, see below)
        func@(XObj (Sym path (LookupGlobal mode AFunction)) _ _) : args ->
          do
            argListAsC <- createArgList indent (mode == ExternalCode) args
            let retTy = case xobjTy func of
                  Just (FuncTy _ rt _) -> rt
                  _ -> error "failed to emit function application for non-function type."
                funcToCall = pathToC path
            if isUnit retTy
              then do
                appendToSrc (addIndent indent ++ funcToCall ++ "(" ++ argListAsC ++ ");\n")
                pure ""
              else do
                let varName = freshVar info
                appendToSrc (addIndent indent ++ tyToCLambdaFix retTy ++ " " ++ varName ++ " = " ++ funcToCall ++ "(" ++ argListAsC ++ ");\n")
                pure varName
        -- Function application (on local symbols and global defs containing lambdas)
        func : args ->
          do
            funcToCall <- visit indent func
            let unwrapLambdas = case func of
                  XObj (Sym _ (LookupGlobal ExternalCode _)) _ _ -> True
                  _ -> False
            argListAsC <- createArgList indent unwrapLambdas args
            let (argTys, retTy) = case xobjTy func of
                  Just (FuncTy at rt _) -> (at, rt)
                  _ -> error ("No type on func " ++ show func)
                voidless = remove isUnit argTys
                castToFn =
                  if unwrapLambdas
                    then tyToCLambdaFix retTy ++ "(*)(" ++ joinWithComma (map tyToCRawFunctionPtrFix voidless) ++ ")"
                    else tyToCLambdaFix retTy ++ "(*)(" ++ joinWithComma (map tyToCLambdaFix voidless) ++ ")"
                castToFnWithEnv =
                  if unwrapLambdas
                    then tyToCLambdaFix retTy ++ "(*)(" ++ joinWithComma (map tyToCRawFunctionPtrFix (StructTy (ConcreteNameTy (SymPath [] "LambdaEnv")) [] : voidless)) ++ ")"
                    else tyToCLambdaFix retTy ++ "(*)(" ++ joinWithComma (map tyToCLambdaFix (StructTy (ConcreteNameTy (SymPath [] "LambdaEnv")) [] : voidless)) ++ ")"
                callLambda = funcToCall ++ ".env ? ((" ++ castToFnWithEnv ++ ")" ++ funcToCall ++ ".callback)" ++ "(" ++ funcToCall ++ ".env" ++ (if null argListAsC then "" else ", ") ++ argListAsC ++ ") : ((" ++ castToFn ++ ")" ++ funcToCall ++ ".callback)(" ++ argListAsC ++ ");\n"
            if isUnit retTy
              then do
                appendToSrc (addIndent indent ++ callLambda)
                pure ""
              else do
                let varName = freshVar info
                appendToSrc (addIndent indent ++ tyToCLambdaFix retTy ++ " " ++ varName ++ " = " ++ callLambda)
                pure varName
        -- Empty list
        [] -> do
          appendToSrc (addIndent indent ++ "/* () */\n")
          pure ""
    visitList _ xobj@(XObj (Lst _) Nothing Nothing) = error ("List is missing info and type! " ++ show xobj)
    visitList _ xobj@(XObj (Lst _) Nothing (Just _)) = error ("List is missing info! " ++ show xobj)
    visitList _ xobj = error ("Must visit list! " ++ show xobj)
    createArgList :: Int -> Bool -> [XObj] -> State EmitterState String
    createArgList indent unwrapLambdas args =
      do
        argStrings <- mapM (visit indent) (remove (isUnit . forceTy) args)
        let argTypes = map forceTy args
            unitless = remove isUnit argTypes
            -- Run side effects
            sideEffects = mapM (visit indent) (filter (isUnit . forceTy) args) <&> intercalate ";\n"
            unwrapped =
              joinWithComma $
                if unwrapLambdas
                  then zipWith unwrapLambda argStrings unitless
                  else argStrings
        sideEffects >> pure unwrapped
    unwrapLambda :: String -> Ty -> String
    unwrapLambda variableName ty =
      if isFunctionType ty
        then variableName ++ ".callback"
        else variableName
    visitArray :: Int -> XObj -> State EmitterState String
    visitArray indent (XObj (Arr xobjs) (Just i) t) =
      do
        let arrayVar = freshVar i
            len = length xobjs
        case t of
          Just (StructTy (ConcreteNameTy (SymPath [] "Array")) [innerTy]) ->
            do
              appendToSrc
                ( addIndent indent ++ "Array " ++ arrayVar
                    ++ " = { .len = "
                    ++ show len
                    ++ ","
                    ++ " .capacity = "
                    ++ show len
                    ++ ","
                    ++ " .data = CARP_MALLOC(sizeof("
                    ++ tyToCLambdaFix innerTy
                    ++ ") * "
                    ++ show len
                    ++ ") };\n"
                )
              zipWithM_ (visitArrayElement indent arrayVar innerTy) [0 ..] xobjs
              pure arrayVar
          _ -> pure "" -- called with non-array type
    visitArray _ _ = error "Must visit array!"
    visitArrayElement :: Int -> String -> Ty -> Int -> XObj -> State EmitterState ()
    visitArrayElement indent arrayVar innerTy index xobj =
      do
        visited <- visit indent xobj
        appendToSrc
          ( case innerTy of
              UnitTy -> "/* () */"
              _ ->
                addIndent indent ++ "((" ++ tyToCLambdaFix innerTy ++ "*)" ++ arrayVar
                  ++ ".data)["
                  ++ show index
                  ++ "] = "
                  ++ visited
                  ++ ";\n"
          )
        pure ()
    visitStaticArray :: Int -> XObj -> State EmitterState String
    visitStaticArray indent (XObj (StaticArr xobjs) (Just i) t) =
      do
        let arrayVar = freshVar i
            retVar = arrayVar ++ "_retref"
            arrayDataVar = arrayVar ++ "_data"
            len = length xobjs
        case t of
          Just tt@(RefTy (StructTy (ConcreteNameTy (SymPath [] "StaticArray")) [innerTy]) _) ->
            do
              appendToSrc (addIndent indent ++ tyToCLambdaFix innerTy ++ " " ++ arrayDataVar ++ "[" ++ show len ++ "];\n")
              appendToSrc
                ( addIndent indent ++ "Array " ++ arrayVar
                    ++ " = { .len = "
                    ++ show len
                    ++ ","
                    ++ " /* .capacity = DOES NOT MATTER, STACK ALLOCATED ARRAY, */"
                    ++ " .data = "
                    ++ arrayDataVar
                    ++ " };\n"
                )
              zipWithM_ (visitStaticArrayElement indent arrayDataVar innerTy) [0 ..] xobjs
              appendToSrc (addIndent indent ++ tyToCLambdaFix tt ++ " " ++ retVar ++ " = &" ++ arrayVar ++ ";\n")
              pure retVar
          _ -> pure "" -- called with non-array type
    visitStaticArray _ _ = error "Must visit static array!"
    visitStaticArrayElement :: Int -> String -> Ty -> Int -> XObj -> State EmitterState ()
    visitStaticArrayElement indent arrayDataVar _ index xobj =
      do
        visited <- visit indent xobj
        appendToSrc (addIndent indent ++ arrayDataVar ++ "[" ++ show index ++ "] = " ++ visited ++ ";\n")
        pure ()

delete :: Int -> Info -> State EmitterState ()
delete indent i = mapM_ deleterToC (infoDelete i)
  where
    deleterToC :: Deleter -> State EmitterState ()
    deleterToC FakeDeleter {} =
      pure ()
    deleterToC PrimDeleter {} =
      pure ()
    deleterToC RefDeleter {} =
      pure ()
    deleterToC deleter@ProperDeleter {} = do
      let v = mangle (deleterVariable deleter)
      case dropPath deleter of
        Just path ->
          appendToSrc $ addIndent indent ++ "" ++ pathToC path ++ "(&" ++ v ++ ");\n"
        Nothing -> pure ()
      appendToSrc $ addIndent indent ++ "" ++ pathToC (deleterPath deleter) ++ "(" ++ v ++ ");\n"

defnToDeclaration :: MetaData -> SymPath -> [XObj] -> Ty -> String
defnToDeclaration meta path@(SymPath _ name) argList retTy =
  let override = Meta.getString (Meta.getCompilerKey Meta.CNAME) meta
      annotations = case fromMaybe emptyList (Meta.get "annotations" meta) of
        (XObj (Lst xs) _ _) -> xs
        _ -> []
      annotationsStr = joinWith " " (map strToC annotations)
      sep = if not (null annotationsStr) then " " else ""
      fullname = if (null override) then (pathToC path) else override
   in annotationsStr ++ sep
        ++ if name == "main"
          then "int main(int argc, char** argv)"
          else
            let retTyAsC = tyToCLambdaFix retTy
                paramsAsC = paramListToC argList
             in (retTyAsC ++ " " ++ fullname ++ "(" ++ paramsAsC ++ ")")
  where
    strToC (XObj (Str s) _ _) = s
    strToC xobj = pretty xobj

templateToC :: Template -> SymPath -> Ty -> String
templateToC template path actualTy =
  let mappings = unifySignatures (templateSignature template) actualTy
      declaration = templateDeclaration template actualTy
      definition = templateDefinition template actualTy
      tokens = concatMap (concretizeTypesInToken mappings (pathToC path) declaration) definition
   in concatMap show tokens ++ "\n"

templateToDeclaration :: Template -> SymPath -> Ty -> String
templateToDeclaration template path actualTy =
  let mappings = unifySignatures (templateSignature template) actualTy
      e = error "Can't refer to declaration in declaration."
      declaration = templateDeclaration template actualTy
      tokens = concatMap (concretizeTypesInToken mappings (pathToC path) e) declaration
      stokens = concatMap show tokens
      term = if "#define" `isPrefixOf` stokens then "\n" else ";\n"
   in stokens ++ term

memberToDecl :: Int -> (XObj, XObj) -> State EmitterState ()
memberToDecl indent (memberName, memberType) =
  case xobjToTy memberType of
    -- Handle function pointers as members specially to allow members that are functions referring to the struct itself.
    Just t -> appendToSrc (addIndent indent ++ tyToCLambdaFix t ++ " " ++ mangle (getName memberName) ++ ";\n")
    Nothing -> error ("Invalid memberType: " ++ show memberType)

defStructToDeclaration :: Ty -> SymPath -> [XObj] -> String
defStructToDeclaration structTy@(StructTy _ _) _ rest =
  let indent = indentAmount
      typedefCaseToMemberDecl :: XObj -> State EmitterState [()]
      -- ANSI C doesn't allow empty structs, insert a dummy member to keep the compiler happy.
      typedefCaseToMemberDecl (XObj (Arr []) _ _) = sequence $ pure $ appendToSrc (addIndent indent ++ "char __dummy;\n")
      typedefCaseToMemberDecl (XObj (Arr members) _ _) = mapM (memberToDecl indent) (remove (isUnit . fromJust . xobjToTy . snd) (pairwise members))
      typedefCaseToMemberDecl _ = error "Invalid case in typedef."
      -- Note: the names of types are not namespaced
      visit = do
        appendToSrc "typedef struct {\n"
        mapM_ typedefCaseToMemberDecl rest
        appendToSrc ("} " ++ tyToC structTy ++ ";\n")
   in if isTypeGeneric structTy
        then "" -- ("// " ++ show structTy ++ "\n")
        else emitterSrc (execState visit (EmitterState ""))
defStructToDeclaration _ _ _ = error "defstructtodeclaration"

defSumtypeToDeclaration :: Ty -> [XObj] -> String
defSumtypeToDeclaration sumTy@(StructTy _ _) rest =
  let indent = indentAmount
      visit = do
        appendToSrc "typedef struct {\n"
        appendToSrc (addIndent indent ++ "union {\n")
        mapM_ (emitSumtypeCase indent) rest
        appendToSrc (addIndent indent ++ "char __dummy;\n")
        appendToSrc (addIndent indent ++ "} u;\n")
        appendToSrc (addIndent indent ++ "char _tag;\n")
        appendToSrc ("} " ++ tyToC sumTy ++ ";\n")
        --appendToSrc ("// " ++ show typeVariables ++ "\n")
        mapM_ emitSumtypeCaseTagDefinition (zip [0 ..] rest)
      emitSumtypeCase :: Int -> XObj -> State EmitterState ()
      emitSumtypeCase ind (XObj (Lst [XObj (Sym (SymPath [] caseName) _) _ _, XObj (Arr []) _ _]) _ _) =
        appendToSrc (addIndent ind ++ "// " ++ caseName ++ "\n")
      emitSumtypeCase ind (XObj (Lst [XObj (Sym (SymPath [] caseName) _) _ _, XObj (Arr memberTys) _ _]) _ _) =
        do
          appendToSrc (addIndent ind ++ "struct {\n")
          let members = zip anonMemberSymbols (remove (isUnit . fromJust . xobjToTy) memberTys)
          mapM_ (memberToDecl (ind + indentAmount)) members
          appendToSrc (addIndent ind ++ "} " ++ caseName ++ ";\n")
      emitSumtypeCase ind (XObj (Sym (SymPath [] caseName) _) _ _) =
        appendToSrc (addIndent ind ++ "// " ++ caseName ++ "\n")
      emitSumtypeCase _ _ = error "emitsumtypecase"
      emitSumtypeCaseTagDefinition :: (Int, XObj) -> State EmitterState ()
      emitSumtypeCaseTagDefinition (tagIndex, XObj (Lst [XObj (Sym (SymPath [] caseName) _) _ _, _]) _ _) =
        appendToSrc ("#define " ++ tagName sumTy caseName ++ " " ++ show tagIndex ++ "\n")
      emitSumtypeCaseTagDefinition (tagIndex, XObj (Sym (SymPath [] caseName) _) _ _) =
        appendToSrc ("#define " ++ tagName sumTy caseName ++ " " ++ show tagIndex ++ "\n")
      emitSumtypeCaseTagDefinition _ = error "emitsumtypecasetagdefinition"
   in if isTypeGeneric sumTy
        then ""
        else emitterSrc (execState visit (EmitterState ""))
defSumtypeToDeclaration _ _ = error "defsumtypetodeclaration"

defaliasToDeclaration :: Ty -> SymPath -> String
defaliasToDeclaration t path =
  case t of
    (FuncTy argTys retTy _) ->
      "typedef " ++ tyToCLambdaFix retTy ++ "(*" ++ pathToC path ++ ")("
        ++ intercalate ", " (map fixer argTys)
        ++ ");\n"
    _ -> "typedef " ++ tyToC t ++ " " ++ pathToC path ++ ";\n"
  where
    fixer UnitTy = "void*"
    fixer x = tyToCLambdaFix x

toDeclaration :: Binder -> String
toDeclaration (Binder meta xobj@(XObj (Lst xobjs) _ ty)) =
  case xobjs of
    [XObj (Defn _) _ _, XObj (Sym path _) _ _, XObj (Arr argList) _ _, _] ->
      case ty of
        (Just (FuncTy _ retTy _)) -> defnToDeclaration meta path argList retTy ++ ";\n"
        _ -> "" -- called with non-function type, emit nothing.
    [XObj Def _ _, XObj (Sym path _) _ _, _] ->
      case ty of
        Just t ->
          let cname = (Meta.getString (Meta.getCompilerKey Meta.CNAME) meta)
              fullname = if (null cname) then pathToC path else cname
           in if (isUnit t)
                then ""
                else tyToCLambdaFix t ++ " " ++ fullname ++ ";\n"
        _ -> "" -- called with no type, emit nothing.
    XObj (Deftype t) _ _ : XObj (Sym path _) _ _ : rest ->
      defStructToDeclaration t path rest
    XObj (DefSumtype t) _ _ : XObj (Sym _ _) _ _ : rest ->
      defSumtypeToDeclaration t rest
    XObj (Deftemplate _) _ _ : _ ->
      ""
    XObj Macro _ _ : _ ->
      ""
    XObj Dynamic _ _ : _ ->
      ""
    XObj DefDynamic _ _ : _ ->
      ""
    [XObj (Instantiate template) _ _, XObj (Sym path _) _ _] ->
      case ty of
        Just t -> templateToDeclaration template path t
        _ -> "" -- called with no type, emit nothing.
    [XObj (Defalias aliasTy) _ _, XObj (Sym path _) _ _] ->
      defaliasToDeclaration aliasTy path
    [XObj (Interface _ _) _ _, _] ->
      ""
    XObj (External _) _ _ : _ ->
      ""
    XObj (ExternalType Nothing) _ _ : _ ->
      ""
    XObj (ExternalType (Just override)) _ _ : XObj (Sym path _) _ _ : _ ->
      "typedef " ++ override ++ " " ++ tyToC (StructTy (ConcreteNameTy path) []) ++ ";"
    XObj (Command _) _ _ : _ ->
      ""
    XObj (Primitive _) _ _ : _ ->
      ""
    _ -> error ("Internal compiler error: Can't emit other kinds of definitions: " ++ show xobj)
toDeclaration (Binder _ (XObj (Sym (SymPath [] "dummy") Symbol) Nothing (Just IntTy))) = ""
toDeclaration _ = error "Missing case."

paramListToC :: [XObj] -> String
paramListToC xobjs =
  if null $ joinWithComma (map getParam xobjs)
    then ""
    else joinWithComma (map getParam (remove (isUnit . forceTy) xobjs))
  where
    getParam :: XObj -> String
    getParam (XObj (Sym (SymPath _ name) _) _ (Just t)) = tyToCLambdaFix t ++ " " ++ mangle name
    getParam invalid = error (show (InvalidParameter invalid))

projectIncludesToC :: Project -> String
projectIncludesToC proj = intercalate "\n" (map includerToC includes) ++ "\n\n"
  where
    includerToC (SystemInclude file) = "#include <" ++ file ++ ">"
    includerToC (RelativeInclude file) = "#include \"" ++ file ++ "\""
    includes = projectIncludes proj

projectPreprocToC :: Project -> String
projectPreprocToC proj = intercalate "\n" preprocs ++ "\n\n"
  where
    preprocs = projectPreproc proj

binderToC :: ToCMode -> Binder -> Either ToCError String
binderToC toCMode binder =
  let xobj = binderXObj binder
   in case xobj of
        XObj (External _) _ _ -> Right ""
        XObj (ExternalType _) _ _ -> Right ""
        XObj (Command _) _ _ -> Right ""
        XObj (Mod env _) _ _ -> envToC env toCMode
        _ -> case xobjTy xobj of
          Just t ->
            if isTypeGeneric t
              then Right ""
              else do
                checkForUnresolvedSymbols xobj
                pure (toC toCMode binder)
          Nothing -> Left (BinderIsMissingType binder)

binderToDeclaration :: TypeEnv -> Binder -> Either ToCError String
binderToDeclaration typeEnv binder =
  let xobj = binderXObj binder
   in case xobj of
        XObj (Mod env _) _ _ -> envToDeclarations typeEnv env
        _ -> case xobjTy xobj of
          Just t -> if isTypeGeneric t then Right "" else Right (toDeclaration binder ++ "")
          Nothing -> Left (BinderIsMissingType binder)

envToC :: Env -> ToCMode -> Either ToCError String
envToC env toCMode =
  let binders' = Map.toList (envBindings env)
   in do
        okCodes <- mapM (binderToC toCMode . snd) binders'
        pure (concat okCodes)

globalsToC :: Env -> Either ToCError String
globalsToC globalEnv =
  let allGlobalBinders = findAllGlobalVariables globalEnv
   in do
        okCodes <-
          mapM
            ( \(score, binder) ->
                fmap
                  (\s -> if s == "" then "" else ("\n    // Depth " ++ show score ++ "\n") ++ s)
                  (binderToC Globals binder)
            )
            (sortGlobalVariableBinders globalEnv allGlobalBinders)
        pure (concat okCodes)

-- | Similar to envToDeclarations, however, to get types, we need to traverse
-- the global environment, pull out local type envs from modules, then emit
-- binders for these types.
--
-- TODO: It should be possible to define a general function that works for both
-- value/type envs, then we can merge this and envToDeclarations
typeEnvToDeclarations :: TypeEnv -> Env -> Either ToCError String
typeEnvToDeclarations typeEnv global =
  let -- We need to carry the type environment to pass the correct environment on the binderToDeclaration call.
      bindersWithScore = (addEnvToScore typeEnv)
      mods = (findModules global)
      allScoredBinders = sortOn fst (foldl go bindersWithScore mods)
   in do
        okDecls <-
          mapM
            ( \(score, binder) ->
                fmap
                  (\s -> if s == "" then "" else ("\n// Depth " ++ show score ++ "\n") ++ s)
                  (binderToDeclaration typeEnv binder)
            )
            allScoredBinders
        pure (concat okDecls)
  where
    addEnvToScore tyE = (sortDeclarationBinders tyE global (map snd (Map.toList (binders tyE))))
    go sorted (XObj (Mod e t) _ _) = sorted ++ (foldl go (addEnvToScore t) (findModules e))
    go xs _ = xs

envToDeclarations :: TypeEnv -> Env -> Either ToCError String
envToDeclarations typeEnv env =
  let bindersWithScore = sortDeclarationBinders typeEnv env (map snd (Map.toList (envBindings env)))
   in do
        okDecls <-
          mapM
            ( \(score, binder) ->
                fmap
                  (\s -> if s == "" then "" else ("\n// Depth " ++ show score ++ "\n") ++ s)
                  (binderToDeclaration typeEnv binder)
            )
            bindersWithScore
        pure (concat okDecls)

-- debugScorePair :: (Int, Binder) -> (Int, Binder)
-- debugScorePair (s,b) = trace ("Scored binder: " ++ show b ++ ", score: " ++ show s) (s,b)

sortDeclarationBinders :: TypeEnv -> Env -> [Binder] -> [(Int, Binder)]
sortDeclarationBinders typeEnv env binders' =
  --trace ("\nSORTED: " ++ (show (sortOn fst (map (scoreBinder typeEnv) binders))))
  sortOn fst (map (scoreTypeBinder typeEnv env) binders')

sortGlobalVariableBinders :: Env -> [Binder] -> [(Int, Binder)]
sortGlobalVariableBinders globalEnv binders' =
  sortOn fst (map (scoreValueBinder globalEnv Set.empty) binders')

checkForUnresolvedSymbols :: XObj -> Either ToCError ()
checkForUnresolvedSymbols = visit
  where
    visit :: XObj -> Either ToCError ()
    visit xobj =
      case xobjTy xobj of
        Nothing -> visitXObj
        Just t ->
          if isTypeGeneric t
            then Left (UnresolvedGenericType xobj)
            else visitXObj
      where
        visitXObj =
          case xobjObj xobj of
            (Lst _) -> visitList xobj
            (Arr _) -> visitArray xobj
            (StaticArr _) -> visitStaticArray xobj
            (MultiSym _ _) -> Left (UnresolvedMultiSymbol xobj)
            (InterfaceSym _) -> Left (UnresolvedInterfaceSymbol xobj)
            _ -> pure ()
    visitList :: XObj -> Either ToCError ()
    visitList (XObj (Lst xobjs) _ _) =
      case mapM visit xobjs of
        Left e -> Left e
        Right _ -> pure ()
    visitList _ = error "The function 'visitList' only accepts XObjs with lists in them."
    visitArray :: XObj -> Either ToCError ()
    visitArray (XObj (Arr xobjs) _ _) =
      case mapM visit xobjs of
        Left e -> Left e
        Right _ -> pure ()
    visitArray _ = error "The function 'visitArray' only accepts XObjs with arrays in them."
    visitStaticArray :: XObj -> Either ToCError ()
    visitStaticArray (XObj (StaticArr xobjs) _ _) =
      case mapM visit xobjs of
        Left e -> Left e
        Right _ -> pure ()
    visitStaticArray _ = error "The function 'visitStaticArray' only accepts XObjs with arrays in them."

wrapInInitFunction :: Bool -> String -> String
wrapInInitFunction with_core src =
  "void carp_init_globals(int argc, char** argv) {\n"
    ++ ( if with_core
           then
             "  System_args.len = argc;\n  System_args.data = argv;\n"
               ++ "#if defined _WIN32\n"
               ++ "  SetConsoleOutputCP(CP_UTF8);\n"
               ++ "#endif"
           else ""
       )
    ++ src
    ++ "}"

removeSuffix :: String -> String
removeSuffix [] = []
removeSuffix [c] = [c]
removeSuffix ('_' : '_' : _) = []
removeSuffix (c : cs) = c : removeSuffix cs
